home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Language/OS - Multiplatform Resource Library
/
LANGUAGE OS.iso
/
lisp
/
kcl
/
akcl
/
kcl.lha
/
c
/
cmpaux.c
< prev
next >
Wrap
C/C++ Source or Header
|
1987-06-04
|
2KB
|
167 lines
/*
(c) Copyright Taiichi Yuasa and Masami Hagiya, 1984. All rights reserved.
Copying of this file is authorized to users who have executed the true and
proper "License Agreement for Kyoto Common LISP" with SIGLISP.
*/
/*
cmpaux.c
*/
#include "include.h"
siLspecialp()
{
object sym;
check_arg(1);
sym = vs_base[0];
if (type_of(sym) == t_symbol &&
(enum stype)sym->s.s_stype == stp_special)
vs_base[0] = Ct;
else
vs_base[0] = Cnil;
}
init_cmpaux()
{
make_si_function("SPECIALP",siLspecialp);
}
int
ifloor(x, y)
int x, y;
{
if (y == 0)
FEerror("Zero divizor", 0);
else if (y > 0)
if (x >= 0)
return(x/y);
else
return(-((-x+y-1))/y);
else
if (x >= 0)
return(-((x-y-1)/(-y)));
else
return((-x)/(-y));
}
int
imod(x, y)
int x, y;
{
return(x - ifloor(x, y)*y);
}
set_VV(VV, n, data)
object VV[];
int n;
object data;
{
object *p, *q;
p = VV;
q = data->v.v_self;
while (n-- > 0)
*p++ = *q++;
data->v.v_self = VV;
}
/*
Conversions to C
*/
char
object_to_char(x)
object x;
{
int c;
switch (type_of(x)) {
case t_fixnum:
c = fix(x); break;
case t_bignum:
c = x->big.big_car; break;
case t_character:
c = char_code(x); break;
default:
FEerror("~S cannot be coerce to a C char.", 1, x);
}
return(c);
}
int
object_to_int(x)
object x;
{
int i;
switch (type_of(x)) {
case t_character:
i = char_code(x); break;
case t_fixnum:
i = fix(x); break;
case t_bignum:
i = x->big.big_car; break;
case t_ratio:
i = number_to_double(x); break;
case t_shortfloat:
i = sf(x); break;
case t_longfloat:
i = lf(x); break;
default:
FEerror("~S cannot be coerce to a C int.", 1, x);
}
return(i);
}
float
object_to_float(x)
object x;
{
float f;
switch (type_of(x)) {
case t_character:
f = char_code(x); break;
case t_fixnum:
f = fix(x); break;
case t_bignum:
case t_ratio:
f = number_to_double(x); break;
case t_shortfloat:
f = sf(x); break;
case t_longfloat:
f = lf(x); break;
default:
FEerror("~S cannot be coerce to a C float.", 1, x);
}
return(f);
}
double
object_to_double(x)
object x;
{
double d;
switch (type_of(x)) {
case t_character:
d = char_code(x); break;
case t_fixnum:
d = fix(x); break;
case t_bignum:
case t_ratio:
d = number_to_double(x); break;
case t_shortfloat:
d = sf(x); break;
case t_longfloat:
d = lf(x); break;
default:
FEerror("~S cannot be coerce to a C double.", 1, x);
}
return(d);
}